1 Podsumowanie analizy

W raporcie badano problem malejącej długości śledzia. Wczytano, opisano i oczyszczono dane. Dokonano analizy danych i koorelacji atrybutów. Zauważono, że największy wpływ przy koorelacji na długość śledzia ma temperatura przy powierzchni wody. Podczas wykorzystania regresorów dla regresji liniowej również ajwiększy wpływ maiała temperatura wody, a dla algorytmu Random Forrest natężenie połowów w regionie. Dla regresji liniowej przewidywana długość śledzia wynosi od 22.75cm 32.33cm, a dla Random Forrest od 20.82cm do 28.41cm.

2 Wykorzystane biblioteki

Do przygotowania raportu wykorzystano bilbioteki:

  • caret
  • data.table
  • dplyr
  • ggcorrplot
  • ggplot2
  • kableExtra
  • knitr
  • plotly
  • tidyr

3 Opis problemu

W Europie zauważono stopniowy spadek długości śledzia oceanicznego, dlatego zbadano warunki w jakich żyją oraz zmierzono ich długość. Obserwacje (50-100 trzyletnich śledzi), które odbywały się w połowach komercyjnych jednostek dotyczą ostatnich 60 lat.

4 Wczytanie danych

Wczytano plik podany na platformie eKursy oraz wyświetlono pierwsze oraz ostatnie wiersze.

read.csv(file='sledzie.csv')->herring_clear

kable(head(herring_clear[,1:8]), format = "markdown", caption = "Herring - początek pobranego zbioru danych PART 1")
Herring - początek pobranego zbioru danych PART 1
X length cfin1 cfin2 chel1 chel2 lcop1 lcop2
0 23.0 0.02778 0.27785 2.46875 ? 2.54787 26.35881
1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881
2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881
3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881
4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881
5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 ? 
kable(head(herring_clear[,9:16]), format = "markdown", caption = "Herring - początek pobranego zbioru danych PART 2")
Herring - początek pobranego zbioru danych PART 2
fbar recr cumf totaln sst sal xmonth nao
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8
0.356 482831 0.3059879 267380.8 14.3069330186 35.51234 7 2.8 
kable(tail(herring_clear[,1:8]), format = "markdown", caption = "Herring - koniec pobranego zbioru danych PART 1")
Herring - koniec pobranego zbioru danych PART 1
X length cfin1 cfin2 chel1 chel2 lcop1 lcop2
52577 52576 21.5 0 0.01 1.02143 26.00617 1.06429 34.1456
52578 52577 24.0 1.02508 3.66319 6.42127 25.51806 10.92857 37.39201
52579 52578 26.0 1.02508 3.66319 6.42127 25.51806 10.92857 37.39201
52580 52579 25.0 1.02508 3.66319 6.42127 25.51806 10.92857 37.39201
52581 52580 25.0 0.36032 5.36402 4.32674 27.16006 5.08099 36.6877
52582 52581 23.5 0.36032 5.36402 4.32674 27.16006 ? 36.6877 
kable(tail(herring_clear[,9:16]), format = "markdown", caption = "Herring - koniec pobranego zbioru danych PART 2")
Herring - koniec pobranego zbioru danych PART 2
fbar recr cumf totaln sst sal xmonth nao
52577 0.100 1322000 0.0922202 648314.9 14.5555996798 35.53620 7 2.05
52578 0.485 724151 0.3838187 457143.9 13.7115996983 35.51169 11 2.05
52579 0.485 724151 0.3838187 457143.9 13.7115996983 35.51169 11 2.05
52580 0.485 724151 0.3838187 457143.9 13.7115996983 35.51169 11 2.05
52581 0.434 441827 0.3726272 191976.2 14.4795996814 35.50777 6 -1.90
52582 0.434 441827 0.3726272 191976.2 14.4795996814 35.50777 6 -1.90

5 Przetwarzanie danych

Sprawdzono, w których kolumnach pojawiają się wartości ?. Jeżeli taka wartość wystąpiła to była pobierana wartość z poprzedniego wiersza dla danej kolumny i przypisywana do sprawdzanego. W przypadku pustych wartości w pierwszym wierszu dane były pobierane z drugiego wiersza. Dodatkowo sprawdzono typy danych dla kolumn. Kolumny, które były typem character zamieniono na numeric. Dane są podane chronologicznie według zapisanych obserwacji.

herring_clear->herring
herring[herring == '?'] <- NA


herring<-fill(herring,cfin1,cfin2,chel1, chel2, lcop1, lcop2, sst, .direction ="updown")
print(sapply(herring, class)) 
##           X      length       cfin1       cfin2       chel1       chel2 
##   "integer"   "numeric" "character" "character" "character" "character" 
##       lcop1       lcop2        fbar        recr        cumf      totaln 
## "character" "character"   "numeric"   "integer"   "numeric"   "numeric" 
##         sst         sal      xmonth         nao 
## "character"   "numeric"   "integer"   "numeric"
herring[, 3:8] <- sapply(herring[, 3:8], as.numeric)
herring[, 13] <- sapply(herring[, 13], as.numeric)
print(sapply(herring, class)) 
##         X    length     cfin1     cfin2     chel1     chel2     lcop1     lcop2 
## "integer" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" 
##      fbar      recr      cumf    totaln       sst       sal    xmonth       nao 
## "numeric" "integer" "numeric" "numeric" "numeric" "numeric" "integer" "numeric"
kable(head(herring[,1:8]), format = "markdown", digits = 2, caption = "Herring - początek sformatowanego zbioru danych PART 1")
Herring - początek sformatowanego zbioru danych PART 1
X length cfin1 cfin2 chel1 chel2 lcop1 lcop2
0 23.0 0.03 0.28 2.47 21.44 2.55 26.36
1 22.5 0.03 0.28 2.47 21.44 2.55 26.36
2 25.0 0.03 0.28 2.47 21.44 2.55 26.36
3 25.5 0.03 0.28 2.47 21.44 2.55 26.36
4 24.0 0.03 0.28 2.47 21.44 2.55 26.36
5 22.0 0.03 0.28 2.47 21.44 2.55 26.36 
kable(head(herring[,9:16]), format = "markdown", digits = 2, caption = "Herring - początek sformatowanego zbioru danych PART 2")
Herring - początek sformatowanego zbioru danych PART 2
fbar recr cumf totaln sst sal xmonth nao
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8
0.36 482831 0.31 267380.8 14.31 35.51 7 2.8

6 Rozmiar zbioru i statystyki

Wszystkie wartości w zbiorze są numeric lub integer. Dotyczą one:

  • length: długość złowionego śledzia [cm];

  • cfin1: dostępnośś planktonu [zagęszczenie Calanus finmarchicus gat. 1];

  • cfin2: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2];

  • chel1: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1];

  • chel2: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2];

  • lcop1: dostępność planktonu [zagęszczenie widłonogów gat. 1];

  • lcop2: dostępność planktonu [zagęszczenie widłonogów gat. 2];

  • fbar: natężenie połowów w regionie [ułamek pozostawionego narybku];

  • recr: roczny narybek [liczba śledzi];

  • cumf: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku];

  • totaln: łączna liczba ryb złowionych w ramach połowu [liczba śledzi];

  • sst: temperatura przy powierzchni wody [°C];

  • sal: poziom zasolenia wody [Knudsen ppt];

  • xmonth: miesiąc połowu [numer miesiąca];

  • nao: oscylacja północnoatlantycka [mb].

Zbiór danych zawiera 52582 wierszy i 16 kolumn. Minimalna długość śledzia: 19. Maksymalna długość śledzia: 32.5. Występuje 0 różnych długości.

Poniżej zostało przedstawione podsumowanie dotyczące wszystkich atrybutów.

kable(summary(herring)[,1:5])
X length cfin1 cfin2 chel1
Min. : 0 Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000
1st Qu.:13145 1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469
Median :26291 Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750
Mean :26291 Mean :25.3 Mean : 0.4457 Mean : 2.0255 Mean :10.003
3rd Qu.:39436 3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500
Max. :52581 Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000 
kable(summary(herring)[,6:11])
chel2 lcop1 lcop2 fbar recr cumf
Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680 Min. : 140515 Min. :0.06833
1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808 1st Qu.:0.2270 1st Qu.: 360061 1st Qu.:0.14809
Median :21.435 Median : 7.0000 Median :24.859 Median :0.3320 Median : 421391 Median :0.23191
Mean :21.215 Mean : 12.8079 Mean :28.419 Mean :0.3304 Mean : 520367 Mean :0.22981
3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232 3rd Qu.:0.4560 3rd Qu.: 724151 3rd Qu.:0.29803
Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490 Max. :1565890 Max. :0.39801

Z wcześniej wspomnianych założeń, że badania są podane chronologicznie można zobaczyć jak na początku rosła długość śledzia, a później częściej malała. Można to zauważyć przy 16640-tej obserwacji.

p<-ggplot(herring, aes(x=X)) + 
  geom_smooth(aes(y = length,colour="lenght"), color = "#4477AA") +
  ggtitle("Animacja długości śledzia") +
  xlab("Numer obserwacji") +
  ylab("Długość śledzia [cm]")

ggplotly(p)
max_length <- layer_data(p)
max_length <- max_length[(which.max(max_length$y)),1:2]


head(max_length)
##           x       y
## 26 16639.56 26.8132

Poniżej przedstawione histogramy przedstawiają liczbę złowionych śledzi o danej długości z podziałem na miesiące. Można zauważyć, że najwięcej zebrano w sierpniu. Ciekawym przypadkiem jest brak połowów Śledzi o długości ok. 24cm.

ggplot(herring, aes(x=length)) + 
  geom_histogram(bins=30)+ facet_wrap(xmonth ~ .) + 
  theme(panel.grid.major = element_line(colour = "blue")) +
  scale_x_continuous(breaks = round(seq(min(herring$length), max(herring$length), by = 2),1)) +
  ggtitle("Histogramy długości śledzia dla danego miesiąca") +
  xlab("Długość śledzia [cm]") +
  ylab("Liczba śledzi")

Poniższy wykres przedstawia linie trendu dostępności planktonów. Nawiększe zagęszczenie mają 2. gatunek widłogonów, a najmniejszy 1. gatunek Calanus finmarchicus.

ggplot(herring, aes(x=length)) + 
  geom_smooth(aes(y = cfin1,colour="cfin1", color = "#4477AA")) + 
  geom_smooth(aes(y = cfin2,colour="cfin2", color="#EE6677")) + 
  geom_smooth(aes(y = chel1,colour="chel1", color="#228833")) +
  geom_smooth(aes(y = chel2,colour="chel2", color="#CCBB44")) +
  geom_smooth(aes(y = lcop1,colour="lcop1", color="#66CCEE")) +
  geom_smooth(aes(y = lcop2,colour="lcop2", color="#AA3377")) +
  scale_colour_manual(name="legend", values=c("#4477AA", "#EE6677","#228833","#CCBB44","#66CCEE","#AA3377")) +
  ylab(bquote("Plankton availability")) + 
  ggtitle("Linie trendu dostępności planktonów") +
  xlab("Długość śledzia [cm]") +
  ylab("Dostępnośc planktonu")

Sprawdzono korelacje między zmiennymi. Nie sprawdzana była koorelacja numeru obserwacji z innymi atrybutami. Długość śledzia ma najsilniejszy współczynnik (-0.5) korelacji z temperaturą przy powierzchni wody (sst). Największy współczynnik korelacji (0.9) występuje dla zagęszczenia planktonów: Calanus finmarchicus gat. 2 (chel2) i widłonogów gat. 2 (lcop2). Miesiące mają nasłabsze współczynniki korelacji z innymi atrybutami.

data(herring)
corr <- round(cor(herring[-1]),1)
ggcorrplot(corr, lab=TRUE, title="") + 
    ggtitle("Koorelacje między zmiennymi")

Na wykresie pokazującym jak zależy długość śledzia od temperatury przy powierzchni wody można zaobserwować, że długość śledzia gwałtownie spada przy temperaturze 14 \u00b0 C

ggplot(herring) + 
  geom_smooth(aes(x=sst, y=length)) + 
  ggtitle("Trend długości śledzia zależny od temperatury") +
  xlab("Temperatura \u00b0C") +
  ylab("Długość śledzia [cm]")

Sprawdzono jak zależą od siebie atrybuty dla największego współczynnika koorelacji:

ggplot(herring) + 
  geom_smooth(aes(x=lcop2, y=chel2)) + 
  ggtitle("Trend zagęszczenia widłonogów gat. 2 zależny od \nzagęszczenia Calanus helgolandicus gat. 2")

Wysoki współczynnik koorelacji (0,7) mają atrybuty: natężenie połowów w regionie (fbar) i łączne roczne natężenie w regionie (cumf). Natomiast wysoki ujemny współczynnik (-0,7) koorelacji mają łączna liczba ryb złowiona w ramach połowu (totaln) i łączne roczne natężenie w regionie (cumf).

ggplot(herring) + 
  geom_smooth(aes(x=cumf, y=fbar))+facet_wrap(vars(xmonth)) +
  ggtitle("Trend natężenia połowów w regionie") +
  xlab("Roczne natężenie połowów") +
  ylab("Natężenie połowów")

ggplot(herring) + 
  geom_smooth(aes(x=cumf, y=totaln))+facet_wrap(vars(xmonth)) +
  ggtitle("Trend łącznej liczby złowionych ryb i natężenia połowu w regionie") +
  xlab("Natężenie połowów w regionie") +
  ylab("Łączna liczba złowionych ryb")

Brak wpływu na długość śledzia mają roczny narybek (recr) oraz łączne roczne natężenie połowów w regionie (cumf).

ggplot(herring) + 
  geom_smooth(aes(x=length, y=recr))+facet_wrap(vars(xmonth)) +
  ggtitle("Trend rocznego narybku i długości śledzia") +
  xlab("Długość śledzia") +
  ylab("Roczny narybek")

ggplot(herring) +
  geom_smooth(aes(x=length, y=cumf))+facet_wrap(vars(xmonth)) +
  ggtitle("Trend łącznego rocznego natężenia połowów w regionie i długości") +
  xlab("Łączne roczne natężenie połowów w regionie") +
  ylab("Łączna liczba złowionych ryb")

7 Regresor przewidujący rozmiar śledzia

7.1 Przygotowanie danych

Dokonano podziału zbioru danych na uczące, walidujące i testowe. Zbiór uczący to 75% całego zbioru. Usunięto atrybut X - numer obserwacji. Przygotowano schemat uczenia na podstawie powwtarzającej się oceny krzyżowej (repeatedcv) z 2 podziałami i 5 powtórzeniami.

set.seed(23)
inTraining <- 
    createDataPartition(
        y = herring$length,
        p = .75,
        list = FALSE)

herringWithoutX<-select(herring, -X)

training <- herringWithoutX[ inTraining,]
testing  <- herringWithoutX[-inTraining,]

ctrl <- trainControl(
    method = "repeatedcv",
    number = 2,
    repeats = 5)

7.2 Linear Regression

Przygotowano uczenie przy pomocy regresji liniowej.

fit_lr <- train(length ~ .,
             data = training,
             method = "lm",
             trControl = ctrl,
             ntree = 10)

Dla regresji liniowej miara \(R^2\) wynosi 0.32, a \(RMSE\) 1.36. Najbardziej istotną zmienną jest fbar - natężenie połowóW w regionie. Pokazano podsumowanie dotyczące predykcji dla regresji liniowej.

fit_lr
## Linear Regression 
## 
## 39438 samples
##    14 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times) 
## Summary of sample sizes: 19720, 19718, 19719, 19719, 19719, 19719, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   1.363931  0.3198441  1.084964
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE
varImp(fit_lr)
## lm variable importance
## 
##          Overall
## fbar   100.00000
## cumf    89.52422
## sst     86.92289
## cfin1   24.20914
## lcop1   15.79213
## recr    15.68082
## totaln  12.80698
## nao      5.79945
## lcop2    5.61337
## chel1    4.69380
## cfin2    0.18658
## xmonth   0.14640
## sal      0.07872
## chel2    0.00000
ggplot(varImp(fit_lr))

predictions_lr <- predict(fit_lr,herringWithoutX)
print(summary(predictions_lr))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   22.75   24.72   25.44   25.30   25.87   32.33

7.3 Random Forrest

Dla porównania wykorzystano również algorytmu Random Forrest.

fit_rf <- train(length ~ .,
             data = training,
             method = "rf",
             trControl = ctrl,
             ntree = 10)

Dla Random Forrest miara \(R^2\) waha się między 0.498 - 0.515, a \(RMSE\) 1.148 - 1.170. Najbardziej istotną zmienną jest sst - temperatura przy powierzchni wody. Pokazano podsumowanie dotyczące predykcji dla algorytmy Random Forrest.

fit_rf
## Random Forest 
## 
## 39438 samples
##    14 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times) 
## Summary of sample sizes: 19719, 19719, 19719, 19719, 19718, 19720, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared   MAE      
##    2    1.170689  0.4989424  0.9256144
##    8    1.148605  0.5177060  0.9047644
##   14    1.151361  0.5158831  0.9055804
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 8.
varImp(fit_rf)
## rf variable importance
## 
##         Overall
## sst    100.0000
## recr    22.1442
## xmonth  14.1005
## fbar     9.9004
## lcop2    8.5712
## cfin2    8.1121
## lcop1    7.9122
## totaln   7.3580
## nao      4.7147
## chel2    4.1836
## chel1    2.9221
## cumf     1.2219
## sal      0.6018
## cfin1    0.0000
ggplot(varImp(fit_rf))

predictions_rf <- predict(fit_rf,herringWithoutX)
print(summary(predictions_rf))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   20.82   24.60   25.34   25.31   26.23   28.41

7.4 Porównanie

Miara \(R^2\) jest większa dla regresji liniowej. Błąd średniokwadratowy jest mniejszy dla algorytmu Random Forrest. Najbardziej istotna zmienna dla Random Forrest sst - temperatura przy powierzchni wody w regresji liniowej występuje z wysoką wartością na 3 miejscu. Natomiast fbar natężenie połowów w regionie z niską wartością dla Random Forrest występuje na 4 miejscu.